MacTech 1 to 12

home *** CD-ROM | disk | FTP | other *** search

/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Jörg's Folder / trap.compiler < prev

Wrap

Text File | 1992-09-01 | 8.8 KB | 494 lines | [TEXT/NISI]

ONLY I/O ALSO ASSEMBLER ALSO MAC ALSO FORTH DEFINITIONS \ Trapname Trap.opcode traptype selector stacksetup \ IF traptype = ToolTrap \ stacksetup = ( w32 w16 w32 w32 … -- w32/16 ) \ IF traptype = OSTrap \ stacksetup = ( A0.W D0.W A1.W -- xx.W ) \ ( A0.L D0.L A1.L -- xx.L ) \ Examples \ Open A000 OSTrap ( A0.L -- D0.W ) \ HOpen A200 OSTrap ( A0.L -- D0.W ) \ HOpen,ASYNC A600 OSTrap ( A0.L -- D0.W ) \ Silly A999 OSTrap REG( 1234 ) ( A0.L -- D0.W ) 1 CONSTANT trap.input 0 CONSTANT trap.output 1 CONSTANT OSTrap 2 CONSTANT ToolTrap 60 USER FILEID VARIABLE compile.state VARIABLE trapType VARIABLE input.parms VARIABLE trap.buffer 22 VALLOT VARIABLE name.buffer 28 VALLOT CODE HashName16 ( @pstr -- hashvalue ) MOVE.L (A6)+,A0 MOVEQ.L #0,D2 MOVE.B (A0)+,D2 MOVE.L D2,D0 AND.B #$1F,D2 BRA.S @lptest @loop ROL.W #7,D0 MOVE.B (A0)+,D1 EOR.B D1,D0 @lptest DBRA D2,@loop MOVE.L D0,-(A6) RTS END-CODE : -- trap.output compile.state ! ; : w32 trapType @ ToolTrap = IF compile.state @ trap.input = IF 1 input.parms +! trap.buffer 4+ W@ 2* 1+ trap.buffer 4+ W! ELSE ( set the two high bits of byte4 ) input.parms @ $3F AND $40 OR input.parms ! THEN ELSE CR ." Cannot mix OSTrap and ToolTrap Definitions." ABORT THEN ; : w16 trapType @ ToolTrap = IF compile.state @ trap.input = IF 1 input.parms +! trap.buffer 4+ W@ 2* trap.buffer 4+ W! ELSE ( set the two high bits of byte4 ) input.parms @ $3F AND $80 OR input.parms ! THEN ELSE CR ." Cannot mix OSTrap and ToolTrap Definitions." ABORT THEN ; : A1.W compile.state @ trap.input = IF trap.buffer 4+ W@ $80 OR $FFBF AND trap.buffer 4+ W! 1 input.parms +! ELSE trap.buffer 4+ W@ $0002 OR $FFFE AND trap.buffer 4+ W! 16 input.parms +! THEN ; : A1.L compile.state @ trap.input = IF trap.buffer 4+ W@ $C0 OR trap.buffer 4+ W! 1 input.parms +! ELSE trap.buffer 4+ W@ $0003 OR trap.buffer 4+ W! 16 input.parms +! THEN ; : A0.W compile.state @ trap.input = IF trap.buffer 4+ W@ $800 OR $FBFF AND trap.buffer 4+ W! 1 input.parms +! ELSE trap.buffer 4+ W@ $0020 OR $FFEF AND trap.buffer 4+ W! 16 input.parms +! THEN ; : A0.L compile.state @ trap.input = IF trap.buffer 4+ W@ $C00 OR trap.buffer 4+ W! 1 input.parms +! ELSE trap.buffer 4+ W@ $0030 OR trap.buffer 4+ W! 16 input.parms +! THEN ; : D0.W compile.state @ trap.input = IF trap.buffer 4+ W@ $200 OR $FEFF AND trap.buffer 4+ W! 1 input.parms +! ELSE trap.buffer 4+ W@ $0008 OR $FFFB AND trap.buffer 4+ W! 16 input.parms +! THEN ; : D0.L compile.state @ trap.input = IF trap.buffer 4+ W@ $300 OR trap.buffer 4+ W! 1 input.parms +! ELSE trap.buffer 4+ W@ $000C OR trap.buffer 4+ W! 16 input.parms +! THEN ; : compile.selector ( n -- ) ( The logic works like this: set bit 15 of the trap word IF the selector is to be put in D0 set bit 14 of the trap word IF the selector is a longword set bit 13 of the trapword ELSE the selector is a word clear bit 13 of the trapword THEN ELSE the selector is to be put on the stack clear bit 14 of the trap word IF the selector is a longword set bit 13 of the trapword ELSE CLEAR bit 13 of the trapword THEN THEN ) trap.buffer 6 + ! trap.buffer 10 + W@ $8000 OR trap.buffer 10 + W! ; : is.white.space? C@ DUP $20 = SWAP $09 = OR ; : get.next.word { | start.addr addr word.addr -- addr } ( imitate WORD but remove white space ) WORD -> word.addr word.addr 1+ -> addr BEGIN addr is.white.space? WHILE 1 +> addr REPEAT addr -> start.addr 1 +> addr BEGIN addr is.white.space? NOT WHILE 1 +> addr REPEAT addr start.addr - word.addr C! start.addr word.addr 1+ = NOT IF ( move the string ) start.addr word.addr 1+ word.addr C@ CMOVE THEN word.addr ; : REG( ( word to compile a 16-bit selector into D0 ) ASCII ) get.next.word NUMBER? 0= IF CR ." A trap routine selector must follow REG( " ABORT ELSE ( -- selector ) ( set bit 14 of the Trap word ) trap.buffer 10 + W@ $4000 OR $DFFF AND trap.buffer 10 + W! compile.selector THEN ; : LREG( ( word to compile a longword->D0 selector ) ASCII ) get.next.word NUMBER? 0= IF CR ." A trap routine selector must follow REG( " ABORT ELSE ( -- selector ) ( set bit 14 and 13 of the Trap word ) trap.buffer 10 + W@ $6000 OR trap.buffer 10 + W! compile.selector THEN ; : STACK( ( word to return the size of a defined record ) ASCII ) get.next.word NUMBER? 0= IF CR ." A trap routine selector must follow STACK( " CR ABORT ELSE ( -- selector ) trap.buffer 10 + W@ $9FFF AND trap.buffer 10 + W! compile.selector THEN ; : LSTACK( ( word to return the size of a defined record ) ASCII ) get.next.word NUMBER? 0= IF CR ." A trap routine selector must follow STACK( " CR ABORT ELSE ( -- selector ) trap.buffer 10 + W@ $BFFF AND $2000 OR trap.buffer 10 + W! compile.selector THEN ; : SPECIAL trap.buffer 10 + W@ $1000 OR trap.buffer 10 + W! ; : compile.stack.spec { | tword -- } trap.input compile.state ! 0 input.parms ! BEGIN 32 WORD -> tword tword C@ 1 = tword 1+ C@ ASCII ) = AND NOT WHILE tword FIND 0= IF CR ." Could not find stack spec word." ABORT ELSE LINK>BODY EXECUTE THEN REPEAT input.parms @ trap.buffer 3 + C! ; : compile.trap { tword | save.base -- } tword C@ name.buffer C! tword C@ 31 > IF 31 ELSE tword C@ THEN 0 DO I 1+ tword + C@ DUP $60 > IF $DF AND THEN name.buffer I 1+ + C! LOOP name.buffer HashName16 trap.buffer W! tword 1+ C@ trap.buffer 2+ C! tword C@ trap.buffer 12 + C! tword C@ 1- 13 > IF 13 ELSE tword C@ 1- THEN tword 2+ trap.buffer 13 + ROT CMOVE ( now compile the opcode ) 32 WORD -> tword tword BASE @ -> save.base HEX NUMBER? save.base BASE ! 0= IF CR ." The Trap Opcode must follow the trapname." ABORT ELSE $0FFF AND trap.buffer 10 + W! THEN ( set trapType ) 32 WORD FIND 0= IF CR ." Could not find the TrapType definition." ABORT ELSE LINK>BODY DUP ['] SPECIAL = IF EXECUTE 32 WORD FIND 0= IF CR ." Could not find the TrapType definition." ABORT THEN LINK>BODY THEN EXECUTE ( -- trapType ) CASE OSTrap OF $7FFF trap.buffer 4+ W@ AND trap.buffer 4+ W! OSTrap trapType ! ENDOF ToolTrap OF $8000 trap.buffer 4+ W@ OR trap.buffer 4+ W! ToolTrap trapType ! ENDOF ( else ) DROP CR ." Trap type definition (OS or Tool) is not valid." ABORT ENDCASE THEN ( now handle optional selector ) 32 WORD -> tword tword NUMBER? IF ( -- selector ) ( set bit 15 of the trap word ) trap.buffer 10 + W@ $8000 OR $9FFF AND trap.buffer 10 + W! ( store the selector ) trap.buffer 6 + ! BEGIN 0 WORD 1+ C@ ASCII ( = UNTIL ELSE DROP ( the invalid number ) ( it is either REG, STACK, or a open-paren ) tword C@ 1 = tword 1+ C@ ASCII ( = AND IF -1 trap.buffer 6 + ! ELSE tword FIND 0= IF CR ." Could not find the Trap selector word " tword COUNT TYPE ABORT ELSE LINK>BODY EXECUTE ( now look for an open-paren to start the stack spec ) BEGIN 0 WORD 1+ C@ ASCII ( = UNTIL THEN THEN THEN compile.stack.spec trapType @ ToolTrap = IF trap.buffer 4+ W@ $8000 OR trap.buffer 4+ W! THEN ; : save.TrapData { thandle | file.str refnum old.handle -- } " my.Trap.Data" -> file.str file.str CALL OpenResFile -> refnum refnum 0> NOT IF file.str CALL CreateResFile file.str CALL OpenResFile -> refnum THEN refnum 0> IF 0 CALL SetResLoad ASCII TEXT 2 CALL GetResource ( -- handle ) -> old.handle old.handle 0= NOT IF old.handle CALL RmveResource old.handle CALL DisposHandle DROP refnum CALL UpdateResFile THEN 1 CALL SetResLoad thandle ASCII TEXT 2 " TrapData" CALL AddResource refnum CALL UpdateResFile refnum CALL CloseResFile ELSE CR ." Could not create the resource file " file.str COUNT TYPE ABORT THEN ; : compile.traplist { | tword thandle toffset saved.BLK saved.>IN -- } 4 CALL NewHandle 0= IF -> thandle STANDARD-GETFILE 0= NOT IF BLK @ -> saved.BLK -1 BLK ! >IN @ -> saved.>IN 0 >IN ! 0 -> toffset BEGIN 32 WORD -> tword tword C@ 0= NOT WHILE \ CR ." Compiling trap " tword COUNT TYPE trap.buffer 12 0 FILL trap.buffer 12 + 14 32 FILL thandle CALL GetHandleSize 26 + thandle SWAP CALL SetHandleSize 0= NOT IF CR ." Memory Error while expanding trap description buffer." ABORT THEN tword compile.trap ( at this point the trap should be compiled in trap.buffer ) trap.buffer thandle @ toffset + 26 CMOVE 26 +> toffset REPEAT saved.BLK BLK ! saved.>IN >IN ! FILEID W@ CLOSEFILE $25252525 thandle @ toffset + ! thandle save.TrapData thandle CALL DisposHandle DROP THEN ELSE CR ." Memory problems allocating handle." ABORT THEN ;